home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
totsrc11.zip
/
TOTSYS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-04
|
15KB
|
667 lines
{ Copyright 1991 TechnoJock Software, Inc. }
{ All Rights Reserved }
{ Restricted by License }
{ Build # 1.10 }
Unit totSYS;
{$I TOTFLAGS.INC}
{
Development History:
03/15/91 1.00a Changed DesqView checks
02/03/92 1.00b Changed tDate to tOSDate (conflicted with TotDate)
12/15/92 1.10 DPMI update
}
INTERFACE
uses DOS, CRT;
TYPE
tVideo = (UnKnown, Mono, CGA, MCGAMono, MCGACol, EGAMono, EGACol, VGAMono, VGACol);
tOSDate = (USA,Europe,Japan);
pDisplayOBJ = ^DisplayOBJ;
DisplayOBJ = object
vSnowProne : boolean; {does system suffer from snow}
vWidth : byte; {no. of characters of display}
vDepth: byte; {no. of lines of display}
vBaseOfScreen: pointer; {location of video memory} {5.00a}
vDisplayType: tVideo; {video display type}
vForceBW: boolean; {uses monochrome color schemes}
{methods...}
constructor Init;
function TestVideo: tVideo;
function SnowProne: boolean;
function GetMode: byte;
function ColorOn: boolean;
function Width: byte;
function Depth: byte;
function DisplayType: tVideo;
procedure SetCondensed;
procedure SetBW(on:boolean);
procedure Set25;
function BaseOfScreen:pointer; {returns ptr to video memory}
destructor Done;
end; {DisplayOBJ}
pEquipOBJ = ^EquipOBJ;
EquipOBJ = object
vMainInfo: word;
vComputerID: byte;
vRomDate: string[8];
{methods...}
constructor Init;
function ComputerID: byte;
function ParallelPorts: byte;
function SerialPorts: byte;
function FloppyDrives: byte;
function ROMDate: string;
function GameAdapter: boolean;
function SerialPrinter: boolean;
function MathChip: boolean;
destructor Done;
end; {EquipOBJ}
pMemOBJ = ^MemOBJ;
MemOBJ = object
vMemInfo: word;
vMaxExtMem: word;
vMaxExpMem: word;
vEMMInstalled: boolean;
vEMMmajor: byte;
vEMMminor: byte;
{methods...}
constructor Init;
function BaseMemory: integer;
function EMMInstalled: boolean;
function EMMVersionMajor: byte;
function EMMVersionMinor: byte;
function EMMVersion: string;
function MaxExtMem: word;
function MaxExpMem: word;
function ExtMemAvail: word;
function ExpMemAvail: word;
destructor Done;
end; {MemOBJ}
pOSOBJ = ^OSOBJ;
OSOBJ = object {Operating System}
vMajor: byte;
vMinor: byte;
vCountry: word;
vDateFmt: tOSDate;
vCurrency: string[5];
vThousands: byte;
vDecimal: byte;
vDateSeparator: byte;
vTimeSeparator: byte;
vTimeFmt: byte;
vCurrencyFmt: byte;
vCurrencyDecPlaces: byte;
{methods...}
constructor Init;
function OSVersionMajor: byte;
function OSVersionMinor: byte;
function OSVersion: string;
function Country: word;
function Currency: string;
function DateFmt: tOSDate;
function TimeFmt: byte;
function ThousandsSep: char;
function DecimalSep: char;
function DateSep: char;
function TimeSep: char;
function CurrencyFmt: byte;
function CurrencyDecPlaces: byte;
destructor Done;
end; {OSOBJ}
procedure sysINIT;
VAR
Monitor: ^DisplayObj;
IMPLEMENTATION
{||||||||||||||||||||||||||||||||||||}
{ }
{ D I S P L A Y S T U F F }
{ }
{||||||||||||||||||||||||||||||||||||}
constructor DisplayObj.Init;
{}
var
Mode : byte;
Regs: Registers;
begin
vDisplayType := TestVideo;
(* Disabled due to driver conflicts
with Regs do
begin
AX := $2B01; {1.00a DesqViewTest}
CX := $4445;
DX := $5351;
intr($21,Regs);
if Al <> $FF then {DesqView present}
begin
Ah := $FE;
Intr($10,Regs);
vBaseOfScreen := ptr(ES,DI);
end
else
begin
Mode := GetMode;
if Mode = 7 then
vBaseOfScreen := ptr($B000,0) {Mono}
else
vBaseOfScreen := ptr($B800,0); {Color}
end;
end;
*)
Mode := GetMode;
{$IFDEF DPMI} {1.10}
if Mode = 7 then
vBaseOfScreen := ptr(segB000,0) {Mono}
else
vBaseOfScreen := ptr(segB800,0); {Color}
{$ELSE}
if Mode = 7 then
vBaseOfScreen := ptr($B000,0) {Mono}
else
vBaseOfScreen := ptr($B800,0); {Color}
{$ENDIF}
vSnowProne := (vDisplayType = CGA);
vWidth := 80;
vDepth := succ(Hi(WindMax));
vForceBW := false;
end; {DisplayObj.Init}
function DisplayOBJ.TestVideo: tVideo;
{}
var
Regs: Registers;
Equip: byte;
Temp: tVideo;
begin
with Regs do
begin
Al := $00;
Ah := $1A; {get VGA info}
Intr($10,Regs);
if Al = $1A then
case Bl of
$00: Temp := unknown;
$01: Temp := Mono;
$04: Temp := EGACol;
$05: Temp := EGAMono;
$07: Temp := VGAMono;
$08: Temp := VGACol;
$0A,
$0C: Temp := MCGACol;
$0B: Temp := MCGAMono;
else
Temp := CGA;
end {case}
else {more checking needed}
begin
Ah := $12;
BX := $10; {get EGA data}
Intr($10,Regs);
if BX = $10 then {EGA or Mono}
begin
Intr($11,Regs);
if ((Al and $30) shr 4) = 3 then
Temp := Mono
else
Temp := CGA;
end
else
begin
Ah := $12;
BX := $10; {one more time!}
Intr($10,Regs);
if Bh = 0 then
Temp := EGACol
else
Temp := EGAMono;
end; {if}
end; {if}
end; {with}
TestVideo := Temp;
end; {DisplayOBJ.TestVideo}
function DisplayObj.GetMode;
{}
var Regs : registers;
begin
with Regs do
begin
Ax := $0F00;
Intr($10,Regs); {get video display mode}
GetMode := Al;
end;
end; {DisplayObj.GetMode}
function DisplayObj.ColorOn: boolean;
{}
begin
if (vForceBW)
or (DisplayType in [Mono, MCGAMono, EGAMono, VGAMono])
or (GetMode = 2) then {Mode BW80 active}
ColorOn := False
else
ColorOn := true;
end; {DisplayObj.ColorOn}
procedure DisplayOBJ.SetBW(On:boolean);
{}
begin
vForceBW := On;
end; {DisplayOBJ.SetBW}
function DisplayObj.BaseOfScreen: pointer;
{}
begin
BaseofScreen := vBaseOfScreen; {1.00a}
end; {DisplayObj.BaseOfScreen}
function DisplayObj.SnowProne: boolean;
{}
begin
SnowProne := vSnowProne;
end; {DisplayObj.SnowProne}
function DisplayObj.Width: byte;
{}
begin
Width := vWidth;
end; {DisplayObj.Width}
function DisplayObj.Depth: byte;
{}
begin
Depth := vDepth;
end; {DisplayObj.Depth}
function DisplayObj.DisplayType: tVideo;
{}
begin
DisplayType := vDisplayType;
end; {DisplayObj.DisplayType}
procedure DisplayObj.SetCondensed;
{sets to maximum number od display lines supported by the display system}
begin
if vDisplayType in [EGAMono,EGACol,VGAMono,VGACol] then
begin
TextMode(Lo(LastMode)+Font8x8);
vDepth := succ(Hi(WindMax));
end;
end; {DisplayObj.SetCondensed}
procedure DisplayObj.Set25;
{resets display back to 25 lines}
begin
if Depth <> 25 then
begin
TextMode(Lo(LastMode));
vDepth := succ(Hi(WindMax));
end;
end; {DisplayObj.Set25}
destructor DisplayObj.Done;
begin end;
{||||||||||||||||||||||||||||||||||||}
{ }
{ E Q U I P S T U F F }
{ }
{||||||||||||||||||||||||||||||||||||}
constructor EquipOBJ.Init; {1.10}
{}
var
Reg: registers;
IDPtr: pointer;
ROMPtr: pointer;
begin
intr($11,Reg);
vMa